home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 16 / context.zip / CONTEXT.PAS < prev   
Pascal/Delphi Source File  |  1986-10-22  |  31KB  |  956 lines
  1. program context;
  2.  
  3. {
  4. Version 1.0, Oct 1986.
  5. Converts disk text formats from one DOS word processor to another.
  6. Formats: ASCII, WordStar/NewWord, WordPerfect, PCWrite, Personal Editor.
  7. By Jim Boylston, Charlotte KUG BBS #1, 704/372-6225
  8. }
  9.  
  10. label quit;
  11.  
  12. var
  13.   infile, outfile : text;
  14.   inname, outname : string[64];
  15.   informat, outformat, letter, a, b, d, e : char;
  16.   valid, sub : boolean;
  17.   counter : integer;
  18.  
  19. procedure firstScreen;
  20. begin
  21. clrscr;
  22. writeln; writeln;
  23. writeln ('                              CONTEXT v1.0');
  24. writeln ('                              ------------');
  25. writeln ('                Convert text formats for word processors');
  26. writeln;
  27. writeln ('                Available formats:');
  28. writeln ('                          A: plain ASCII');
  29. writeln ('                          B: WordStar/NewWord');
  30. writeln ('                          C: WordPerfect');
  31. writeln ('                          D: Personal Editor');
  32. writeln ('                          E: PCWrite');
  33. writeln;
  34. end;
  35.  
  36. procedure getformat (var format : char);
  37. begin
  38. valid := true;
  39. write   ('format -> ');
  40. read (kbd, format);
  41. case format of
  42.   'A', 'a' : writeln ('ASCII');
  43.   'B', 'b' : writeln ('WordStar/NewWord');
  44.   'C', 'c' : writeln ('WordPerfect');
  45.   'D', 'd' : writeln ('Personal Editor');
  46.   'E', 'e' : writeln ('PCWrite');
  47.   else begin
  48.     valid := false;
  49.     writeln ('not a valid choice');
  50.     end;
  51.   end; {case}
  52. end; {procedure getformat}
  53.  
  54. procedure getinfile;
  55. var ok : boolean;
  56. begin
  57. repeat
  58.   writeln ('        Source filename');
  59.   write   ('        (drive:\dir allowed) -> ');
  60.   readln (inname);
  61.   assign (infile, inname);
  62.   {$I-} reset (infile) {$I+};
  63.   ok := (IOresult = 0);
  64.   if not ok then writeln ('        Can''t find source file. Try again.');
  65.   until ok;
  66. writeln;
  67. end; {procedure getinfile}
  68.  
  69. procedure getoutfile;
  70. var
  71.   answer : char;
  72.   ok : boolean;
  73. begin
  74. repeat
  75.   writeln ('        Destination filename');
  76.   write   ('        (drive:\dir allowed) -> ');
  77.   readln (outname);
  78.   assign (outfile, outname);
  79.   {$I-} reset (outfile) {$I+};
  80.   if IOresult = 0 then begin
  81.     write ('        File already exists. Overwrite? (Y/N) '); readln (answer);
  82.     ok := (upcase (answer) ='Y');
  83.     end {if}
  84.     else ok := true;
  85.   until ok;
  86. rewrite (outfile);
  87. end; {procedure getoutfile}
  88.  
  89. {==============================================}
  90. { SUBROUTINES CALLED BY TRANSLATION PROCEDURES }
  91. {==============================================}
  92.  
  93. procedure epsoncodes2ws;
  94. { translates Personal Editor Epson codes to WS }
  95. begin
  96.   case ord (d) of { d = the 1st char of printer code }
  97.     45 : begin { underline }
  98.            write (outfile, ^S);
  99.            if not eof (infile) then read (infile, d);
  100.            end;
  101.     69 : begin
  102.            write (outfile, ^B); { bold begin }
  103.            d := e;
  104.            end;
  105.     70 : begin
  106.            write (outfile, ^B); { bold end }
  107.            d := e;
  108.            end;
  109.     83 : begin { sub and superscripts }
  110.            if e = '1' then begin { it's a subscript }
  111.              sub := true;
  112.              write (outfile, ^V);
  113.              end
  114.            else { it's a superscript }
  115.              write (outfile, ^T);
  116.            if not eof (infile) then read (infile, d);
  117.            end;
  118.     84 : begin { scripts off }
  119.            if sub then begin
  120.              write (outfile, ^V);
  121.              end
  122.            else begin
  123.              write (outfile, ^T);
  124.              end;
  125.            d := e;
  126.            sub := false;
  127.            end;
  128.     end; { case }
  129.     if not eof (infile) then read (infile, e); { now have new d & e }
  130. end; { procedure epsoncodes2ws }
  131.  
  132. procedure epsoncodes2wp;
  133. { translates Personal Editor Epson codes to PW }
  134. begin
  135.   case ord (d) of
  136.     45 : begin { underline }
  137.            if e = '1' then write (outfile, chr(148))
  138.              else write (outfile, chr(149));
  139.            if not eof (infile) then read (infile, d);
  140.            end;
  141.     69 : begin
  142.            write (outfile, chr(157)); { bold begin }
  143.            d := e;
  144.            end;
  145.     70 : begin
  146.            write (outfile, chr(156)); { bold end }
  147.            d := e;
  148.            end;
  149.     83 : begin { sub and superscripts }
  150.            if e = '1' then begin { it's a subscript }
  151.              sub := true;
  152.              write (outfile, chr(189));
  153.              end
  154.            else write (outfile, chr(188)); { it's a superscript }
  155.            if not eof (infile) then read (infile, d);
  156.            end; { scripts begin }
  157.     84 : begin
  158.            if sub then sub := false;  { scripts end }
  159.            d := e;
  160.            end;
  161.     end; { case }
  162.     if not eof (infile) then read (infile, e); { now have new d & e }
  163. end; { procedure epsoncodes2wp }
  164.  
  165. procedure epsoncodes2pcw;
  166. { translates Personal Editor Epson codes to PCW }
  167. begin
  168.   read (infile, letter); { get the printer code }
  169.   case ord (letter) of
  170.     45 : begin { underline }
  171.            write (outfile, ^W);
  172.            read (infile, letter);
  173.            end;
  174.     52 : write (outfile, ^U); { italic begin }
  175.     53 : write (outfile, ^U); { italic end }
  176.     69 : write (outfile, ^B); { bold begin }
  177.     70 : write (outfile, ^B); { bold end }
  178.     83 : begin { sub and superscripts }
  179.            read (infile, letter);
  180.            if letter = '1' then begin { it's a subscript }
  181.              sub := true;
  182.              write (outfile, ^Y);
  183.              end
  184.            else write (outfile, ^X); { it's a superscript }
  185.            end; { scripts begin }
  186.     84 : if sub then begin { scripts end }
  187.            write (outfile, ^Y);
  188.            sub := false;
  189.            end
  190.          else write (outfile, ^X);
  191.     end; { case }
  192. end; { procedure epsoncodes2pcw }
  193.  
  194.  
  195. {=======================================}
  196. {SECTION FOR ACTUAL TRANSLATION ROUTINES}
  197. {=======================================}
  198.  
  199. { FROM ASCII TO OTHERS }
  200.  
  201. procedure ascii2ws; { doubles as pe2ws }
  202. { read letters from infile 1 by 1, check against the two preceding chars
  203. called a and b, and the two following chars called d and e }
  204. begin
  205. sub := false;
  206. a := chr(0); b := chr(0); { null these characters for now }
  207. while not eof (infile) do begin
  208.   read (infile, letter);
  209.   while not eof (infile) do begin
  210.     read (infile, d);     { read 2  char ahead }
  211.     while not eof (infile) do begin
  212.       read (infile, e);
  213.       case letter of
  214.         ^I : write (outfile, '     ');  {convert tab to 5 spaces}
  215.         ^J : write (outfile, ^J);
  216.         ^L : write (outfile, ^M, ^J, '.PA', ^M, ^J); { hard page }
  217.         ^M : if (a = ^M) or (e = ^M) then write (outfile, ^M)
  218.              else write (outfile, chr(141)); { make soft cr if not 2 in a row}
  219.         ^[ : epsoncodes2ws; { PE 'esc' printer codes - convert to WS code }
  220.         else if d = ' ' then write (outfile, chr(ord(letter) + 128))
  221.           else write (outfile, letter);
  222.         end; {case}
  223.       a := b; b := letter; letter := d; d := e; { shift char assignments }
  224.       end; { while not eof #3 }
  225.     write (outfile, letter, d, ^M, ^J); { flush the last chars, add final cr }
  226.     end; { while not eof #2 }
  227.   end; { while not eof #1 }
  228. end; {procedure ascii2ws}
  229.  
  230. procedure ascii2wp; { doubles as pe2wp }
  231. begin
  232. sub := false;
  233. a := chr(0); b := chr(0);
  234. while not eof (infile) do begin
  235.   read (infile, letter);
  236.   while not eof (infile) do begin
  237.     read (infile, d);
  238.     while not eof (infile) do begin
  239.       read (infile, e);
  240.       case letter of
  241.         ^[ : epsoncodes2wp; { PE 'esc' printer codes - convert to WP code }
  242.         ^L : write (outfile, chr(220), ^\,^@,^@,^@,^@,^@,^@, chr(220), ^L);
  243.         ^M : if (a = ^M) or (e = ^M) then write (outfile, ^J)
  244.                else write (outfile, ^M);
  245.         ' ' : if d <> ^M then write (outfile, ' '); { no end of line spaces }
  246.         '-' : write (outfile, chr(169)); { WP hard hyphen }
  247.         else if letter <> ^J then write (outfile, letter);
  248.           { don't translate linefeeds }
  249.         end; { case }
  250.       a := b; b := letter; letter := d; d := e; { shift letter assignments }
  251.       end; { while not eof #3 }
  252.       write (outfile, d, ^J); { flush last character, add lf }
  253.     end; { while not eof #2 }
  254.   end; { while not eof #1 }
  255. end; { procedure ascii2wp }
  256.  
  257. { procedure ascii2pe not needed }
  258.  
  259. procedure ascii2pcw;
  260. var letter : char;
  261. begin
  262. while not eof (infile) do begin
  263.   read (infile, letter);
  264.   case letter of
  265.     ^I : write (outfile, '      '); { tab to 6 spaces }
  266.     ^L : write (outfile, ^L, ^O, ^M, ^J); { hardpage }
  267.     else write (outfile, letter);
  268.     end; { case }
  269.   end; { while not eof }
  270. end; { procedure ascii2pcw }
  271.  
  272. {FROM WORDSTAR/NEWWORD TO OTHERS}
  273.  
  274. procedure ws2ascii;
  275. begin;
  276. while not eof (infile) do begin
  277.   read (infile, letter);
  278.   letter := chr(ord(letter) mod 128); {get rid of high bits}
  279.   case letter of { ignore all controls chars but these 2 }
  280.     ^J : write (outfile, ^J);
  281.     ^M : write (outfile, ^M);
  282.     else if ord(letter) > 31
  283.       then write (outfile, letter);
  284.     end; { case }
  285.   end; {while}
  286. end; {procedure ws2ascii}
  287.  
  288. procedure ws2wp;
  289. var
  290.   letter2 : char;
  291.   underline, bold, italic, super : boolean;
  292. begin
  293. underline := false; bold := false; italic := false;
  294. while not eof (infile) do begin
  295.   read (infile, letter);
  296.   while not eof (infile) do begin
  297.    read (infile, letter2);
  298.    case ord (letter) of
  299.      2  : if not bold then begin
  300.             write (outfile, chr(157));
  301.             bold := true;
  302.             end
  303.           else begin
  304.             write (outfile, chr(156));
  305.             bold := false;
  306.             end;
  307.     4  : if not bold then begin
  308.            write (outfile, chr(157));
  309.            bold := true;
  310.            end
  311.          else begin
  312.            write (outfile, chr(156));
  313.            bold := false;
  314.            end;
  315.     13 : write (outfile, ^J); { hardcr }
  316.     19 : if not underline then begin
  317.            write (outfile, chr(148));
  318.            underline := true
  319.            end
  320.          else begin
  321.            write (outfile, chr(149));
  322.            underline := false;
  323.            end;
  324.     20 : if not super then begin
  325.            write (outfile, chr(188));
  326.            super := true;
  327.            end
  328.          else super := false; { superscripts }
  329.     22 : if not sub then begin
  330.            write (outfile, chr(189));
  331.            sub := true;
  332.            end
  333.          else sub := false;
  334.     25 : if not italic then begin
  335.            write (outfile, chr(203), ^L, ^A, ^L, ^D, chr(203));
  336.            italic := true;
  337.            end
  338.          else begin
  339.            write (outfile, chr(203), ^L, ^D, ^L, ^A, chr(203));
  340.            italic := false;
  341.            end;
  342.     32 : if letter2 <> ^M then write (outfile, ' ');
  343.     45 : write (outfile, chr(173)); { hyphen }
  344.     141 : write (outfile, ^M); { softcr }
  345.     173 : write (outfile, 173); { soft hyphen }
  346.     else if (ord (letter) > 31) and (ord (letter) <> 160) { soft sp }
  347.       then write (outfile, chr (ord (letter) mod 128));
  348.     end; { case }
  349.     letter := letter2;
  350.   end; { while not eof #2 }
  351.   write (outfile, letter, ^J); { flush last char, add lf }
  352. end { while not eof #1 }
  353. end; {procedure ws2wp}
  354.  
  355. procedure ws2pe;  { resembles ws2ascii and ws2pcw }
  356. var underline, bold, super : boolean;
  357. begin
  358. underline := false; bold := false; super := false; sub := false;
  359. while not eof (infile) do begin
  360.   read (infile, letter);
  361.   case letter of
  362.     ^B : if not bold then begin
  363.            write (outfile, ^[, 'E');
  364.            bold := true;
  365.            end
  366.          else begin
  367.            write (outfile, ^[, 'F');
  368.            bold := false;
  369.            end;
  370.   ^D : if not bold then begin
  371.          write (outfile, ^[, 'E');
  372.          bold := true;
  373.          end
  374.        else begin
  375.          write (outfile, ^[, 'F');
  376.          bold := false;
  377.          end;
  378.   ^S : if not underline then begin
  379.          write (outfile, ^[, '-1');
  380.          underline := true;
  381.          end
  382.        else begin
  383.          write (outfile, ^[, '-0');
  384.          underline := false;
  385.          end;
  386.    ^T : if not super then begin
  387.           write (outfile, ^[, 'S0');
  388.           super := true;
  389.           end
  390.         else begin
  391.           write (outfile, ^[, 'T');
  392.           super := false;
  393.           end;
  394.    ^V : if not sub then begin
  395.           write (outfile, ^[, 'S1');
  396.           sub := true;
  397.           end
  398.         else begin
  399.           write (outfile, ^[, 'T');
  400.           sub := false;
  401.           end;
  402.    else if ord (letter) <> 160 { omit soft spaces }
  403.      then write (outfile, chr (ord (letter) mod 128));
  404.    end; { case }
  405.   end; { while not eof }
  406. end; { procedure ws2pe }
  407.  
  408. procedure ws2pcw;
  409. var
  410.   underline : boolean;
  411. begin
  412. underline := false;
  413. while not eof (infile) do begin
  414.   read (infile, letter);
  415.   case letter of
  416.     ^B : write (outfile, ^B); { bold }
  417.     ^D : write (outfile, ^B);
  418.     ^J : write (outfile, ^J);
  419.     ^M : if underline then begin { must start underline anew each line }
  420.            write (outfile, ^W, ^M, ^J, ^W);
  421.            read (infile, letter); { skip the linefeed }
  422.            end { if underline }
  423.          else write (outfile, ^M);
  424.     ^S : begin
  425.            write (outfile, ^W); { underline }
  426.            if (underline = false) then underline := true
  427.            else underline := false;
  428.            end;
  429.     ^T : write (outfile, ^X); { superscript }
  430.     ^V : write (outfile, ^Y); { subscript }
  431.     ^Y : write (outfile, ^U); { italic }
  432.     else if (ord (letter) > 31) and (ord(letter) <> 160)
  433.       then write (outfile, chr(ord(letter) mod 128));
  434.     end; { case }
  435.   end; {while}
  436. end; { procedure ws2pcw }
  437.  
  438. {FROM WORDPERFECT TO OTHERS}
  439.  
  440. procedure wp2ascii;
  441. begin
  442. while not eof (infile) do begin
  443.   read (infile, letter);
  444.   case ord(letter) of
  445.     9  : write (outfile, ^I);
  446.     10 : write (outfile, ^M, ^J);
  447.     13 : write (outfile, ' ', ^M, ^J);
  448.     169 : write (outfile, '-');  { WordPerfect special hyphen chars }
  449.     170 : write (outfile, '-', ^M, ^J);
  450.     173 : write (outfile, '-');
  451.     194 : for counter := 1 to 2 do read (infile, letter); { skip mar rel }
  452.     195 : for counter := 1 to 4 do read (infile, letter); { centered }
  453.     196 : for counter := 1 to 4 do read (infile, letter); { flush right }
  454.     203 : for counter := 1 to 5 do read (infile, letter); { skip font changes }
  455.     204 : for counter := 1 to 3 do read (infile, letter); { indented paragraph }
  456.     209 : repeat { headers and footers not translated }
  457.             read (infile, letter)
  458.             until letter = chr(209);
  459.     220 : begin  { page break }
  460.            for counter := 1 to 9 do read (infile, letter);
  461.            write (outfile, ^L);
  462.            end;
  463.     222 : for counter := 1 to 3 do read (infile, letter); { indented paragraph }
  464.     else if (ord(letter) > 31 ) and (ord(letter) < 127) then
  465.       write (outfile, letter);
  466.     end; { case }
  467.   end; { while not eof }
  468. end; { procedure wp2ascii }
  469.  
  470. procedure wp2ws;
  471. var
  472.   letter2 : char;
  473.   header, indent : boolean; { special formats }
  474. begin
  475. header := false; indent := false;
  476. while not eof (infile) do begin
  477.   read (infile, letter);
  478.   while not eof (infile) do begin
  479.     read (infile, letter2);
  480.     case ord(letter) of
  481.       2  : if header then write (outfile, '#');
  482.       9  : write ( outfile, '     '); { tab -> 5 spaces }
  483.       10 : if not header then write ( outfile, ^M, ^J); { hardcr }
  484.       13 : if indent then write ( outfile, ' ', chr(141), ^J, chr(160),
  485.              chr(160), chr(160), chr(160), chr(160)) { 5 soft spaces }
  486.              else write ( outfile, ' ', chr(141), ^J); { space, softcr }
  487.              { special provision for reverse indented paragraphs }
  488.       148 : write ( outfile, ^S); { begin underline }
  489.       149 : write ( outfile, ^S); { end underline }
  490.       156 : write ( outfile, ^B); { end bold print }
  491.       157 : write ( outfile, ^B); { begin bold print }
  492.       169 : write ( outfile, '-'); { WP hard hyphen }
  493.       170 : write (outfile, '-', chr(141), ^J); { WP hyphen end of line }
  494.       173 : write (outfile, chr(173)); { soft hyphen }
  495.       194 : for counter := 1 to 2 do read (infile, letter2); { mar rel }
  496.       195 : for counter := 1 to 4 do read (infile, letter2); { centered }
  497.       196 : for counter := 1 to 4 do read (infile, letter2); { flush right }
  498.       203 : begin
  499.               for counter := 1 to 5 do read (infile, letter2); { font changes }
  500.               write (outfile, ^Y);
  501.               end;
  502.       204 : begin
  503.               indent := true;
  504.               for counter := 1 to 3 do read (infile, letter2);
  505.               end;
  506.       209 : if header = false then begin { headers AND footers }
  507.               header := true;
  508.               if (letter2 = ^A) or (letter2 = ^@)
  509.                 then write (outfile, ^M, ^J, '.HE')
  510.               else write (outfile, ^M, ^J, '.FO');
  511.               for counter := 1 to 6 do read (infile, letter2);
  512.               end
  513.             else begin
  514.               header := false;
  515.               write (outfile, ^M, ^J);
  516.               end;
  517.       220 : if letter2 = ^\ then begin
  518.               write (outfile, ^M, ^J, '.PA', ^M, ^J);
  519.               for counter := 1 to 9 do read (infile, letter2);
  520.               end;
  521.       222 : begin
  522.               indent := false; { WP end indented paragraph marker }
  523.               for counter := 1 to 3 do read (infile, letter2);
  524.               end;
  525.       else if (ord (letter) > 31) and (ord (letter) < 127) then begin
  526.         if letter2 = ' ' then write (outfile, chr (ord(letter) + 128))
  527.         else write (outfile, letter);
  528.         end; { if ord > 31 ..: Puts in soft chars }
  529.       end; { case }
  530.     letter := letter2;
  531.     end; { while not eof #2 }
  532.     write (outfile, letter);
  533.   end; { while not eof #1 }
  534. end; { procedure wp2ws }
  535.  
  536. procedure wp2pe;
  537. begin
  538. while not eof (infile) do begin
  539.   read (infile, letter);
  540.   case ord(letter) of
  541.     9  : write (outfile, ^I);
  542.     10 : write (outfile, ^M, ^J);
  543.     13 : write (outfile, ' ', ^M, ^J);
  544.     148 : write (outfile, ^[, '-1'); { underline begin }
  545.     149 : write (outfile, ^[, '-0'); { underline end }
  546.     156 : write (outfile, ^[, 'F'); { bold end }
  547.     157 : write (outfile, ^[, 'E'); { bold begin }
  548.     169 : write (outfile, '-');  { WordPerfect special hyphen chars }
  549.     170 : write (outfile, '-', ^M, ^J);
  550.     173 : write (outfile, '-');
  551.     188 : begin { superscript }
  552.             write (outfile, ^[, 'S0');
  553.             read (infile, letter);
  554.             write (outfile, letter, ^[, 'T');
  555.             end;
  556.     189 : begin { subscript }
  557.             write (outfile, ^[, 'S1');
  558.             read (infile, letter);
  559.             write (outfile, letter, ^[, 'T');
  560.             end;
  561.     194 : for counter := 1 to 2 do read (infile, letter); { mar rel }
  562.     195 : for counter := 1 to 4 do read (infile, letter); { center }
  563.     196 : for counter := 1 to 4do read (infile, letter); { flush right }
  564.     203 : for counter := 1 to 5 do read (infile, letter); { font changes }
  565.     204 : for counter := 1 to 3 do read (infile, letter); { indented paragraph }
  566.     209 : repeat { headers and footers not translated }
  567.             read (infile, letter)
  568.             until letter = chr(209);
  569.     220 : begin  { page break }
  570.            for counter := 1 to 9 do read (infile, letter);
  571.            write (outfile, ^L, ^M, ^J);
  572.            end;
  573.     222 : for counter := 1 to 3 do read (infile, letter); { indented }
  574.     else if (ord(letter) > 31 ) and (ord(letter) < 127) then
  575.       write (outfile, letter);
  576.     end; { case }
  577.   end; { while not eof }
  578. end; { procedure wp2pe }
  579.  
  580. procedure wp2pcw;
  581. var
  582.   underline, header : boolean;
  583. begin
  584. underline := false; header := false;
  585. while not eof (infile) do begin
  586.   read (infile, letter);
  587.   case ord(letter) of
  588.     9  : write (outfile, '      '); { tab to 6 spaces }
  589.     10 : if underline then write (outfile, ^W, ^M, ^J, ^W)
  590.            else write (outfile, ^M, ^J);
  591.     13 : if underline then write (outfile, ' ', ^M, ^J, ^W)
  592.            else write (outfile, ' ', ^M, ^J);
  593.     148 : begin
  594.            underline := true;
  595.            write (outfile, ^W);
  596.            end;
  597.     149 : begin
  598.            underline := false;
  599.            write (outfile, ^W);
  600.            end;
  601.     156 : write ( outfile, ^B); { end bold print }
  602.     157 : write ( outfile, ^B); { begin bold print }
  603.     169 : write (outfile, '-');  { WordPerfect special hyphen chars }
  604.     170 : write (outfile, '-', ^M, ^J);
  605.     173 : write (outfile, '-');
  606.     188 : begin { superscript }
  607.             write (outfile, ^X);
  608.             if not eof (infile) then read (infile, letter);
  609.             write (outfile, letter);
  610.             write (outfile, ^X);
  611.             end;
  612.     189 : begin { subscript }
  613.             write (outfile, ^Y);
  614.             if not eof (infile) then read (infile, letter);
  615.             write (outfile, letter);
  616.             write (outfile, ^Y);
  617.             end;
  618.     195 : for counter := 1 to 4 do read (infile, letter);
  619.     196 : for counter := 1 to 4 do read (infile, letter); { flush right }
  620.     203 : begin { italic or font change }
  621.             for counter := 1 to 5 do read (infile, letter);
  622.             write (outfile, ^U);
  623.             end;
  624.     204 : for counter := 1 to 3 do read (infile, letter);
  625.     208 : for counter := 1 to 2 do read (infile, letter);
  626.     209 : if header = false then begin
  627.               header := true;
  628.               read (infile, letter);
  629.               if (letter = ^A) or (letter = ^@)
  630.                 then write (outfile, ^M, ^J, '.H:')
  631.               else write (outfile, ^M, ^J, '.F:');
  632.               for counter := 1 to 5 do read (infile, letter);
  633.               end
  634.             else begin
  635.               header := false;
  636.               write (outfile, ^M, ^J);
  637.               end;
  638.    220 : begin { page break }
  639.             read (infile, letter);
  640.             if letter = ^\ then begin
  641.               write (outfile, ^L, ^O, ^M, ^J);
  642.               end; { if }
  643.             for counter := 1 to 8 do read (infile, letter);
  644.             end; { 220 }
  645.     222 : for counter := 1 to 3 do read (infile, letter); { mar rel not }
  646.     else if (ord(letter) > 31 ) and (ord(letter) < 127) then
  647.       write (outfile, letter);
  648.     end; { case }
  649.   end; { while not eof }
  650. end; { wp2pcw }
  651.  
  652. { FROM PERSONAL EDITOR TO OTHERS }
  653.  
  654. procedure pe2ascii;
  655. { pe is ascii with embedded Epson printer commands }
  656. var letter : char;
  657. begin
  658. while not eof (infile) do begin
  659.   read (infile, letter);
  660.   if letter = ^[ then begin { printer code }
  661.     read (infile, letter); { read the next character }
  662.     case letter of
  663.       'W' : read (infile, letter); { skip a character }
  664.       'S' : read (infile, letter); { skip a character }
  665.       '-' : read (infile, letter); { skip a character }
  666.       'm' : read (infile, letter); { skip a character }
  667.       end; { case }
  668.     end { if }
  669.   else if letter <> ^I then write (outfile, letter);
  670.   end; { while not eof }
  671. end; { pe2ascii }
  672.  
  673. procedure pe2ws;
  674. begin
  675. ascii2ws;
  676. end; { procedure pe2ws }
  677.  
  678. procedure pe2wp;
  679. begin
  680. ascii2wp;
  681. end; { procedure pe2wp }
  682.  
  683. procedure pe2pcw;
  684. begin
  685. sub := false;
  686. while not eof (infile) do begin
  687.   read (infile, letter);
  688.   case letter of
  689.     ^I : write (outfile, '      '); { tab to 6 spaces }
  690.     ^L : write (outfile, ^L, ^O, ^M, ^J); { hardpage }
  691.     ^[ : epsoncodes2pcw; { PE printer code - convert to PCW }
  692.     else write (outfile, letter);
  693.     end; { case }
  694.   end; { while not eof }
  695. end; { procedure pe2pcw }
  696.  
  697. { FROM PCWRITE TO OTHERS }
  698.  
  699. procedure pcw2ascii;
  700. var letter : char;
  701. begin
  702. while not eof (infile) do begin
  703.   read (infile, letter);
  704.   case letter of
  705.     ^M : write (outfile, ^M); { ignore all control chars except these }
  706.     ^J : write (outfile, ^J);
  707.     ^L : write (outfile, ^L);
  708.     else if ord(letter) > 31 then write (outfile, letter);
  709.     end; { case }
  710.   end; { while not eof }
  711. end; { procedure pcw2ascii }
  712.  
  713. procedure pcw2ws;
  714. { the same as ascii2ws with printer codes added }
  715. begin
  716. a := chr(0); b := chr(0); { null these characters for now }
  717. while not eof (infile) do begin
  718.   read (infile, letter);
  719.   while not eof (infile) do begin
  720.     read (infile, d);     { read 2  char ahead }
  721.     while not eof (infile) do begin
  722.       read (infile, e);
  723.       case letter of
  724.         ^B : write (outfile, ^B); { bold }
  725.         ^J : write (outfile, ^J);
  726.         ^L : begin
  727.                write (outfile, ^M, ^J, '.PA', ^M, ^J); { hard page }
  728.                d := e; read (infile, e); { skip the ^O }
  729.                end;
  730.         ^M : if (a = ^M) or (e = ^M) then write (outfile, ^M)
  731.              else write (outfile, chr(141)); { make soft cr if not 2 in a row}
  732.         ^U : write (outfile, ^Y); { italic }
  733.         ^W : write (outfile, ^S); { underline }
  734.         ^X : write (outfile, ^T); { superscript }
  735.         ^Y : write (outfile, ^V); { subscript }
  736.         else if d = ' ' then write (outfile, chr(ord(letter) + 128))
  737.           else write (outfile, letter);
  738.         end; {case}
  739.       a := b; b := letter; letter := d; d := e; { shift char assignments }
  740.       end; { while not eof #3 }
  741.     write (outfile, letter, d, ^M, ^J); { flush last chars, add final cr }
  742.     end; { while not eof #2 }
  743.   end; { while not eof #1 }
  744. end; { procedure pcw2ws }
  745.  
  746. procedure pcw2wp;
  747. { nearly same as ascii2wp }
  748. var
  749.   bold, italic, underline, super : boolean;
  750. begin
  751. a := chr(0); b := chr(0);
  752. while not eof (infile) do begin
  753.   read (infile, letter);
  754.   while not eof (infile) do begin
  755.     read (infile, d);
  756.     while not eof (infile) do begin
  757.       read (infile, e);
  758.       case letter of
  759.         ^B : if not bold then begin
  760.                write (outfile, chr(157));
  761.                bold := true;
  762.                end
  763.              else begin
  764.                write (outfile, chr(156));
  765.                bold := false;
  766.                end;
  767.         ^L : begin { page break }
  768.                write (outfile, chr(220), ^\,^@,^@,^@,^@,^@,^@, chr(220), ^L);
  769.                d := e;
  770.                if not eof (infile) then read (infile, e);
  771.                end;
  772.         ^M : if (a = ^M) or (e = ^M) then write (outfile, ^J)
  773.                else write (outfile, ^M);
  774.         ^U : if not italic then begin
  775.                write (outfile, chr(203), ^L, ^A, ^L, ^D, chr(203));
  776.                italic := true;
  777.                end
  778.              else begin
  779.                write (outfile, chr(203), ^L, ^D, ^L, ^A, chr(203));
  780.                italic := false;
  781.                end;
  782.         ^W : if not underline then begin
  783.                write (outfile, chr(148));
  784.                underline := true;
  785.                end
  786.              else begin
  787.                write (outfile, chr(149));
  788.                underline := false;
  789.                end;
  790.         ^X : if not super then begin
  791.                write (outfile, chr(188));
  792.                super := true;
  793.                end
  794.              else super := false;
  795.         ^Y : if not sub then begin
  796.                write (outfile, chr(189));
  797.                sub := true;
  798.                end
  799.              else sub := false;
  800.         ' ' : if (d <> ^M) and (d <> ' ')  { gets rid of right just. }
  801.                 then write (outfile, ' '); { and end of line spaces }
  802.         '-' : write (outfile, chr(169)); { WP hard hyphen }
  803.         else if letter <> ^J then write (outfile, letter);
  804.           { don't translate linefeeds }
  805.         end; { case }
  806.       a := b; b := letter; letter := d; d := e; { shift letter assignments }
  807.       end; { while not eof #3 }
  808.       write (outfile, d, ^J); { flush last character }
  809.     end; { while not eof #2 }
  810.   end; { while not eof #1 }
  811. end; { procedure pcw2wp }
  812.  
  813. procedure pcw2pe;
  814. var
  815.   underline, bold, super : boolean;
  816. begin
  817. underline := false; bold := false; super := false; sub := false;
  818. while not eof (infile) do begin
  819.   read (infile, letter);
  820.   case letter of
  821.     ^B : if bold = false then begin
  822.            write (outfile, ^[, 'E');
  823.            bold := true;
  824.            end
  825.          else begin
  826.            write (outfile, ^[, 'F');
  827.            bold := false;
  828.            end;
  829.     ^L : begin                     { formfeed }
  830.            write (outfile, ^L);
  831.            read (infile, letter); { skip the ^O that follows }
  832.            end;
  833.     ^W : if underline = false then begin
  834.            write (outfile, ^[,'-1');
  835.            underline := true;
  836.            end
  837.          else begin
  838.            write (outfile, ^[, '-0');
  839.            underline := false;
  840.            end;
  841.     ^X : if not super then begin
  842.            write (outfile, ^[, 'S0');
  843.            super := true;
  844.            end
  845.          else begin
  846.            write (outfile, ^[, 'T');
  847.            super := false;
  848.            end;
  849.     ^Y : if not sub then begin
  850.            write (outfile, ^[,'S1');
  851.            sub := true;
  852.            end
  853.          else begin
  854.            write (outfile, ^[, 'T');
  855.            sub := false;
  856.            end;
  857.     else write (outfile, letter);
  858.     end; { case }
  859.   end; { while not eof }
  860. end; { procedure pcw2pe }
  861.  
  862.  
  863. {======================================}
  864. {SECTION TO CHOOSE TRANSLATION ROUTINES}
  865. {======================================}
  866.  
  867. procedure asciiroutine;
  868. begin
  869. case outformat of
  870.   'B', 'b' : ascii2ws;
  871.   'C', 'c' : ascii2wp;
  872.   { D not used - ascii2pe not needed }
  873.   'E', 'e' : ascii2pcw;
  874.   end; {case}
  875. end; {ascii routine}
  876.  
  877. procedure wsroutine;
  878. begin
  879. case outformat of
  880.   'A', 'a' : ws2ascii;
  881.   'C', 'c' : ws2wp;
  882.   'D', 'd' : ws2pe;
  883.   'E', 'e' : ws2pcw;
  884.   end; {case}
  885. end; {wsroutine}
  886.  
  887. procedure wproutine;
  888. begin
  889. case outformat of
  890.   'A', 'a' : wp2ascii;
  891.   'B', 'b' : wp2ws;
  892.   'D', 'd' : wp2pe;
  893.   'E', 'e' : wp2pcw;
  894.   end; { case }
  895. end; {procedure wproutine}
  896.  
  897. procedure peroutine;
  898. begin
  899. case outformat of
  900.   'A', 'a' : pe2ascii;
  901.   'B', 'b' : pe2ws;
  902.   'C', 'c' : pe2wp;
  903.   'E', 'e' : pe2pcw;
  904.   end; { case }
  905. end; { peroutine }
  906.  
  907. procedure pcwroutine;
  908. begin
  909. case outformat of
  910.   'A', 'a' : pcw2ascii;
  911.   'B', 'b' : pcw2ws;
  912.   'C', 'c' : pcw2wp;
  913.   'D', 'd' : pcw2pe;
  914.   end; { case }
  915. end; { pcwroutine }
  916.  
  917. procedure chooseroutine;
  918. begin
  919. case informat of
  920.   'A', 'a' : asciiroutine;
  921.   'B', 'b' : wsroutine;
  922.   'C', 'c' : wproutine;
  923.   'D', 'd' : peroutine;
  924.   'E', 'e' : pcwroutine;
  925.   end; { case }
  926. end;
  927.  
  928. {=================}
  929. {MAIN PROGRAM LINE}
  930. {=================}
  931.  
  932. begin {context}
  933. firstScreen;
  934. repeat
  935.   write ('        Source '); getformat (informat)
  936.   until valid;
  937. getinfile;
  938. repeat
  939.   write ('        Destination '); getformat (outformat)
  940.   until valid;
  941. If upcase(outformat) = upcase(informat) then
  942.   writeln ('        No translation routine required. Ending program.');
  943. If upcase(outformat) = upcase(informat) then goto quit;
  944. if (upcase (outformat) = 'A') and (upcase (outformat) = 'D') then
  945.   writeln ('Personal Editor reads pure ASCII files. No translation needed.');
  946. if (upcase (outformat) = 'A') and (upcase (outformat) = 'D') then goto quit;
  947. getoutfile;
  948. writeln;
  949. writeln ('        Reading file:   ', inname);
  950. writeln ('        Producing file: ', outname);
  951. chooseroutine;
  952. close (outfile);
  953. writeln; writeln ('        Done.'); writeln;
  954. quit : close (infile);
  955. end.
  956.